home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
001
/
pibt40s2.arc
/
PIBANSIB.MOD
< prev
next >
Wrap
Text File
|
1987-09-22
|
54KB
|
1,529 lines
(*----------------------------------------------------------------------*)
(* Ansi_Insert_Lines --- Insert empty lines in display *)
(*----------------------------------------------------------------------*)
PROCEDURE Ansi_Insert_Lines;
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Ansi_Insert_Lines; *)
(* *)
(* Purpose: Inserts empty lines in display *)
(* *)
(* Calling Sequence: *)
(* *)
(* Ansi_Insert_Lines; *)
(* *)
(* Called by: VT100_Process_Escape *)
(* *)
(*----------------------------------------------------------------------*)
VAR
L: INTEGER;
Y: INTEGER;
BEGIN (* Ansi_Insert_Lines *)
Y := WhereY;
IF ( ( Y >= Top_Scroll ) AND ( Y <= Bottom_Scroll ) ) THEN
BEGIN
IF ( Escape_Number = 0 ) THEN
L := 1
ELSE
L := MAX( 1 , Escape_Register[1] );
IF ( ( Y + L - 1 ) > Bottom_Scroll ) THEN
L := ( Bottom_Scroll - Y + 1 );
IF ( L > 0 ) THEN
BEGIN
Scroll( Y, Bottom_Scroll, 1, Max_Screen_Col, -L, FG, BG );
Ansi_Scroll_Attributes( 1 , Y - 1 );
END;
END;
END (* Ansi_Insert_Lines *);
(*----------------------------------------------------------------------*)
(* Ansi_Delete_Lines --- Delete empty lines in display *)
(*----------------------------------------------------------------------*)
PROCEDURE Ansi_Delete_Lines;
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Ansi_Delete_Lines; *)
(* *)
(* Purpose: Deletes lines in display *)
(* *)
(* Calling Sequence: *)
(* *)
(* Ansi_Delete_Lines; *)
(* *)
(* Called by: VT100_Process_Escape *)
(* *)
(*----------------------------------------------------------------------*)
VAR
L: INTEGER;
Y: INTEGER;
BEGIN (* Ansi_Delete_Lines *)
{==
Window( 1, 1, Max_Screen_Col, Ansi_Last_Line );
==}
Y := WhereY;
IF ( ( Y >= Top_Scroll ) AND ( Y <= Bottom_Scroll ) ) THEN
BEGIN
IF ( Escape_Number = 0 ) THEN
L := 1
ELSE
L := MAX( Escape_Register[1] , 1 );
IF ( ( Y + L - 1 ) > Bottom_Scroll ) THEN
L := ( Bottom_Scroll - Y + 1 );
IF ( L > 0 ) THEN
BEGIN
Scroll( Y, Bottom_Scroll, 1, Max_Screen_Col, L, FG, BG );
Ansi_Scroll_Attributes( -1 , Y - 1 );
END;
END;
{==
IF Origin_Mode THEN
Window( 1, Top_Scroll, Max_Screen_Col, Bottom_Scroll );
==}
END (* Ansi_Delete_Lines *);
(*----------------------------------------------------------------------*)
(* Ansi_Delete_Chars --- Delete characters in display *)
(*----------------------------------------------------------------------*)
PROCEDURE Ansi_Delete_Chars;
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Ansi_Delete_Chars; *)
(* *)
(* Purpose: Deletes characters in display *)
(* *)
(* Calling Sequence: *)
(* *)
(* Ansi_Delete_Chars; *)
(* *)
(* Called by: VT100_Process_Escape *)
(* *)
(*----------------------------------------------------------------------*)
VAR
L : INTEGER;
I : INTEGER;
C1 : INTEGER;
C2 : INTEGER;
Y : INTEGER;
Ch : CHAR;
Co : BYTE;
BEGIN (* Ansi_Delete_Chars *)
IF ( Escape_Number = 0 ) THEN
L := 1
ELSE
L := MAX( Escape_Register[1] , 1 );
C1 := WhereX;
C2 := MIN( C1 + L , Wrap_Screen_Col );
Y := WhereY + Upper_Left_Row - 1;
(* Move characters to left *)
FOR I := C2 TO Wrap_Screen_Col DO
BEGIN
ReadCXY ( Ch, I, Y, Co );
WriteCXY( Ch, C1, Y, Co );
C1 := SUCC( C1 );
END;
(* Blank out rest of line *)
IF ( C1 <= Wrap_Screen_Col ) THEN
BEGIN
GoToXY( C1 , WhereY );
Escape_Number := 0;
Ansi_Clear_Line;
END;
END (* Ansi_Delete_Chars *);
(*----------------------------------------------------------------------*)
(* Ansi_Insert_Chars --- Insert empty lines in display *)
(*----------------------------------------------------------------------*)
PROCEDURE Ansi_Insert_Chars;
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Ansi_Insert_Chars; *)
(* *)
(* Purpose: Inserts characters in display *)
(* *)
(* Calling Sequence: *)
(* *)
(* Ansi_Insert_Chars; *)
(* *)
(* Called by: VT100_Process_Escape *)
(* *)
(*----------------------------------------------------------------------*)
VAR
I : INTEGER;
L : INTEGER;
Save_Insertion_Mode : BOOLEAN;
XPos : INTEGER;
BEGIN (* Ansi_Insert_Chars *)
IF ( Escape_Number = 0 ) THEN
L := 1
ELSE
L := Escape_Register[1];
Save_Insertion_Mode := Insertion_Mode;
Insertion_Mode := TRUE;
XPos := WhereX;
FOR I := 1 TO L DO
Display_Character( ' ' );
Insertion_Mode := Save_Insertion_Mode;
GoToXY( XPos , WhereY );
END (* Ansi_Insert_Chars *);
(*----------------------------------------------------------------------*)
(* VT100_Send_Terminal_Parameters --- Send VT100 terminal params *)
(*----------------------------------------------------------------------*)
PROCEDURE VT100_Send_Terminal_Parameters;
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: VT100_Send_Terminal_Parameters *)
(* *)
(* Purpose: Sends VT100 terminal parameters *)
(* *)
(* Calling Sequence: *)
(* *)
(* VT100_Send_Terminal_Parameters; *)
(* *)
(* Called by: VT100_Process_Escape *)
(* *)
(*----------------------------------------------------------------------*)
VAR
PString : AnyStr;
BString : STRING[5];
BEGIN (* VT100_Send_Terminal_Parameters *)
PString := CHR( ESC ) + '[';
IF ( Escape_Register[1] = 1 ) THEN
PString := PString + '3;'
ELSE
PString := PString + '2;';
CASE Parity OF
'E' : PString := PString + '5;';
'O' : PString := PString + '4;';
ELSE PString := PString + '1;';
END (* CASE *);
CASE Data_Bits OF
7 : PString := PString + '2;';
ELSE PString := PString + '1;';
END (* CASE *);
CASE Baud_Rate OF
300 : BString := '48';
600 : BString := '56';
1200 : BString := '64';
2400 : BString := '88';
4800 : BString := '104';
9600 : BString := '112';
19200: BString := '120';
ELSE BString := '0';
END (* CASE *);
PString := PString + BString + ';' + BString + ';' + '1;0x';
Async_Send_String( PString );
END (* VT100_Send_Terminal_Parameters *);
(*----------------------------------------------------------------------*)
(* VT100_Set_LEDs --- Set LED flags for VT100 *)
(*----------------------------------------------------------------------*)
PROCEDURE VT100_Set_LEDs;
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: VT100_Set_LEDs; *)
(* *)
(* Purpose: Sets VT100 LED flags *)
(* *)
(* Calling Sequence: *)
(* *)
(* VT100_Set_LEDs; *)
(* *)
(* Called by: VT100_Process_Escape *)
(* *)
(*----------------------------------------------------------------------*)
VAR
Led_Number : INTEGER;
I : INTEGER;
BEGIN (* VT100_Set_LEDs *)
IF ( Escape_Number = 0 ) THEN
BEGIN
Escape_Number := 1;
Escape_Register[1] := 0;
END;
FOR I := 1 TO Escape_Number DO
CASE Escape_Register[I] OF
0: BEGIN (* Turn off all LEDs *)
VT100_Led_Vector[1] := FALSE;
VT100_Led_Vector[2] := FALSE;
VT100_Led_Vector[3] := FALSE;
VT100_Led_Vector[4] := FALSE;
END;
1: VT100_Led_Vector[1] := TRUE;
2: VT100_Led_Vector[2] := TRUE;
3: VT100_Led_Vector[3] := TRUE;
4: VT100_Led_Vector[4] := TRUE;
ELSE;
END (* CASE *);
END (* VT100_Set_LEDs *);
(*----------------------------------------------------------------------*)
(* Ansi_Reset_Terminal --- Reset terminal defaults *)
(*----------------------------------------------------------------------*)
PROCEDURE Ansi_Reset_Terminal;
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Ansi_Reset_Terminal *)
(* *)
(* Purpose: Resets terminal defaults *)
(* *)
(* Calling Sequence: *)
(* *)
(* Ansi_Reset_Terminal; *)
(* *)
(* Called by: Emulate_Ansi *)
(* *)
(*----------------------------------------------------------------------*)
BEGIN (* Ansi_Reset_Terminal *)
(* Initialize error handler. *)
ErrorPtr := OFS( Trap_Error );
(* Turn on the cursor *)
CursorOn;
(* Initialize terminal state *)
Done := FALSE;
Alt_Keypad_Mode := OFF;
Graphics_Mode := OFF;
Auto_Print_Mode := OFF;
Origin_Mode := OFF;
Auto_Wrap_Mode := ON;
Printer_Ctrl_Mode := OFF;
Escape_Mode := FALSE;
Escape_Str[0] := #0;
NewX := WhereX;
NewY := WhereY;
Skip_All_Mode := FALSE;
Double_Width_Mode := FALSE;
New_Line := FALSE;
Save_Done := FALSE;
Insertion_Mode := FALSE;
VT100_G0_Set := 'A';
VT100_G1_Set := 'A';
VT100_G0_State := TRUE;
Wrap_Screen_Col := 80;
Current_Status_Time := -1;
(* Set tabs *)
Number_VT100_Tabs := 17;
FOR ITab := 1 TO 9 DO
VT100_Tabs[ITab] := ITab * 8 + 1;
FOR ITab := 10 TO 16 DO
VT100_Tabs[ITab] := 64 + ITab;
VT100_Tabs[17] := Wrap_Screen_Col;
(* Set colors. *)
Ansi_ForeGround_Color := VT100_ForeGround_Color;
Ansi_BackGround_Color := VT100_BackGround_Color;
Ansi_Underline_Color := VT100_Underline_Color;
Ansi_Bold_Color := VT100_Bold_Color;
ForeGround_Color := VT100_ForeGround_Color;
BackGround_Color := VT100_BackGround_Color;
Border_Color := VT100_Border_Color;
FG := VT100_ForeGround_Color;
BG := VT100_BackGround_Color;
Bolding_On := FALSE;
Blinking_On := FALSE;
Reverse_On := FALSE;
Set_Global_Colors( Ansi_ForeGround_Color , Ansi_BackGround_Color );
Set_Border_Color ( Border_Color );
(* Initialize music playing *)
PibPlaySet;
Getting_Music := FALSE;
(* Set status line attribute *)
IF Reverse_Status_Colors THEN
Status_Line_Attr := 16 * ( ForeGround_Color AND 7 ) + BackGround_Color
ELSE
Status_Line_Attr := 16 * ( Status_BackGround_Color AND 7 ) + Status_ForeGround_Color;
Do_Status_Line := Show_Status_Line;
Do_Status_Time := Do_Status_Line AND Show_Status_Time;
IF VT100_Allowed THEN
BEGIN
Ansi_Last_Line := Max_Screen_Line - 1;
Short_Terminal_Name := 'VT100';
END
ELSE
BEGIN
Ansi_Last_Line := Max_Screen_Line;
Short_Terminal_Name := 'ANSI/BBS';
END;
Set_Status_Line_Name(Short_Terminal_Name);
(* Status line to last line *)
IF Do_Status_Line THEN
BEGIN
Ansi_Last_Line := Max_Screen_Line - 1;
Write_To_Status_Line( Status_Line_Name, 1 );
END;
(* Set screen size *)
Window( 1, 1, Max_Screen_Col, Ansi_Last_Line );
(* Ensure proper screen length *)
Set_Screen_Size( Ansi_Last_Line , Max_Screen_Col );
(* Change text attributes *)
Set_Text_Attributes( 1, 1, Max_Screen_Col, Ansi_Last_Line,
Ansi_ForeGround_Color,
Ansi_BackGround_Color );
(* Initial scrolling region is *)
(* entire usable screen. *)
Top_Scroll := 1;
Bottom_Scroll := Ansi_Last_Line;
(* Set line attributes all normal *)
FillChar( Line_Attributes, Max_Screen_Line, 0 );
(* Special keyboard and output chars *)
FOR ITab := 0 TO 255 DO
Special_Comm [ITab] := FALSE;
Special_Comm[NUL] := TRUE;
Special_Comm[ESC] := TRUE;
Special_Comm[LF ] := TRUE;
Special_Comm[CR ] := TRUE;
Special_Comm[FF ] := TRUE;
Special_Comm[VT ] := TRUE;
Special_Comm[HT ] := TRUE;
Special_Comm[ENQ] := TRUE;
Special_Comm[SO ] := TRUE;
Special_Comm[SI ] := TRUE;
Special_Comm[DEL] := TRUE;
Special_Comm[BS ] := TRUE;
Special_Comm[CAN] := TRUE;
Special_Comm[SUB] := TRUE;
(* Set time for status line *)
Current_Status_Time := -1;
(* Check if script tests req'd *)
Do_Script_Tests := Waitstring_Mode OR When_Mode OR
WaitCount_Mode OR WaitQuiet_Mode OR
Script_Learn_Mode;
(* Set save guys *)
Save_Col_Position := NewX - 1;
Save_Row_Position := NewY - 1;
Save_FG_Color := FG;
Save_BG_Color := BG;
Save_Graphics_Mode := Graphics_Mode;
Save_Bolding := Bolding_On;
Save_Blinking := Blinking_On;
Save_Origin_Mode := Origin_Mode;
Save_Top_Scroll := Top_Scroll;
Save_Bottom_Scroll := Bottom_Scroll;
(* No LEDs lit *)
VT100_Led_Vector[1] := FALSE;
VT100_Led_Vector[2] := FALSE;
VT100_Led_Vector[3] := FALSE;
VT100_Led_Vector[4] := FALSE;
END (* Ansi_Reset_Terminal *);
(*----------------------------------------------------------------------*)
(* Ansi_Process_Escape --- Process ANSI escape sequence *)
(*----------------------------------------------------------------------*)
PROCEDURE Ansi_Process_Escape( Ch : CHAR );
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Ansi_Process_Escape *)
(* *)
(* Purpose: Processes escape sequence for BBS/ANSI emulation *)
(* *)
(* Calling Sequence: *)
(* *)
(* Ansi_Process_Escape( Ch: CHAR ); *)
(* *)
(* Ch --- Next character in escape sequence *)
(* *)
(* Called by: Emulate_Ansi *)
(* *)
(* Remarks: *)
(* *)
(* This version doesn't process private DEC escape sequences, *)
(* but DOES play music. *)
(* *)
(*----------------------------------------------------------------------*)
VAR
Reg_Val : INTEGER;
Save_X : INTEGER;
Save_Y : INTEGER;
More_Escape : BOOLEAN;
BEGIN (* Ansi_Process_Escape *)
IF Getting_Music THEN
BEGIN
IF ( ORD( Escape_Str[0] ) < 255 ) THEN
Escape_Str := Escape_Str + Ch;
EXIT;
END;
More_Escape := FALSE;
CASE Ch OF
' ' : EXIT;
^M : EXIT;
^J : EXIT;
'[' : BEGIN
Escape_Type := '[';
EXIT;
END;
'A' : IF Escape_Type <> '[' THEN
More_Escape := TRUE
ELSE
Ansi_Cursor_Up;
'B' : IF Escape_Type <> '[' THEN
More_Escape := TRUE
ELSE
Ansi_Cursor_Down;
'C' : IF Escape_Type <> '[' THEN
More_Escape := TRUE
ELSE
Ansi_Cursor_Right;
'D' : IF Escape_Type <> '[' THEN
More_Escape := TRUE
ELSE
Ansi_Cursor_Left;
'f' : Ansi_Set_Cursor;
'H' : Ansi_Set_Cursor;
'J' : Ansi_Clear_Screen;
'K' : Ansi_Clear_Line;
'L' : BEGIN
Scroll( WhereY, Bottom_Scroll, 1, Max_Screen_Col, -1, FG, BG );
ClrEol;
END;
'M' : BEGIN
Getting_Music := TRUE;
More_Escape := TRUE;
END;
'm' : Ansi_Set_Graphics;
(* Indicate EXEC PC AutoDownload possible *)
^Q : IF Mahoney_On THEN Async_Send_String( 'EXECPC2' );
'O': IF Mahoney_On THEN Exec_PC_Commands;
's': IF Escape_Type = '[' THEN
BEGIN
Save_Row_Position := WhereX;
Save_Col_Position := WhereY;
Save_FG_Color := FG;
Save_BG_Color := BG;
Save_Graphics_Mode := Graphics_Mode;
Save_Bolding := Bolding_On;
Save_Blinking := Blinking_On;
END
ELSE
More_Escape := TRUE;
'u': IF Escape_Type = '[' THEN
BEGIN
MoveToXY( Save_Row_Position , Save_Col_Position );
FG := Save_FG_Color;
BG := Save_BG_Color;
Bolding_On := Save_Bolding;
Blinking_On := Save_Blinking;
Graphics_Mode := Save_Graphics_Mode;
IF Blinking_On THEN
TextColor( FG + Blink )
ELSE
TextColor( FG );
TextBackGround( BG );
END
ELSE
More_Escape := TRUE;
ELSE More_Escape := TRUE;
END (* CASE *);
IF ( NOT More_Escape ) THEN
Escape_Mode := FALSE
ELSE
BEGIN
Ch := UpCase( Ch );
Escape_Str := Escape_Str + Ch;
IF Ch IN Lets THEN EXIT;
IF Ch IN Digits THEN
BEGIN
Escape_Register[Escape_Number] :=
( Escape_Register[Escape_Number] * 10 ) + ORD( Ch ) -
ORD( '0' );
EXIT;
END;
CASE Ch OF
';', ',' : BEGIN
Escape_Number := Escape_Number + 1;
Escape_Register[Escape_Number] := 0;
END;
'T', 'S', '#', '+', '-', '>', '<', '.'
: ;
ELSE
Escape_Mode := FALSE;
Ansi_Write_Escape;
END (* CASE *);
END (* NOT More_Escape *);
END (* Ansi_Process_Escape *);
(*----------------------------------------------------------------------*)
(* Handle_VT100_Special --- Process special chars in VT100 *)
(*----------------------------------------------------------------------*)
PROCEDURE Handle_VT100_Special( Comm_Ch: CHAR );
VAR
Save_Y: INTEGER;
BEGIN (* Handle_VT100_Special *)
Do_Graphics_Mode := Graphics_Mode;
Graphics_Mode := OFF;
CASE ORD( Comm_Ch ) OF
ESC: BEGIN (* ESC found *)
IF Escape_Mode THEN Ansi_Write_Escape;
Escape_Str[0] := #0;
Escape_Number := 1;
Escape_Register[1] := 0;
Escape_Mode := TRUE;
Escape_Type := ' ';
Getting_Music := FALSE;
END;
LF,
FF,
VT: BEGIN (* go down one line *)
Save_Y := WhereY;
IF Auto_Print_Mode THEN
BEGIN
Get_Screen_Text_Line( Print_Line, Save_Y, 1 );
WRITELN( Lst , Print_Line );
END;
IF VT100_Allowed THEN
BEGIN
Save_FG1 := FG;
Save_BG1 := BG;
TextColor ( Ansi_ForeGround_Color );
TextBackGround( Ansi_BackGround_Color );
END;
IF ( Save_Y <= Bottom_Scroll ) THEN
BEGIN
IF ( Save_Y = Bottom_Scroll ) THEN
BEGIN
Window( 1, Top_Scroll, Max_Screen_Col,
Bottom_Scroll );
Display_Character( Comm_Ch );
{==
IF ( NOT Origin_Mode ) THEN
==}
Window( 1, 1, Max_Screen_Col, Ansi_Last_Line );
MOVE( Line_Attributes[ Top_Scroll + 1 ],
Line_Attributes[ Top_Scroll ],
Bottom_Scroll - Top_Scroll );
Line_Attributes[ Bottom_Scroll ] := 0;
ClrEol;
END
ELSE
Display_Character( Comm_Ch );
IF Do_Script_Tests THEN
Do_Script_Checks( Comm_Ch );
END
ELSE
BEGIN
IF ( Save_Y < Ansi_Last_Line ) THEN
Display_Character( Comm_Ch );
IF Capture_On THEN
Capture_Char( Comm_Ch );
IF Printer_On THEN
WRITE( Lst , Comm_Ch );
IF Review_On THEN
Update_Review_Pointers;
IF Do_Script_Tests THEN
Do_Script_Checks( Comm_Ch );
END;
IF VT100_Allowed THEN
BEGIN
TextColor ( Save_FG1 );
TextBackGround( Save_BG1 );
END;
END (* go down one line *);
(* Move to specified tab column *)
HT: IF VT100_Allowed THEN
Handle_Tab( VT100_Tabs , Number_VT100_Tabs )
ELSE
BEGIN
Display_Character( Comm_Ch );
IF Do_Script_Tests THEN
Do_Script_Checks( Comm_Ch );
END;
SO: IF VT100_Allowed THEN
BEGIN
VT100_G0_State := FALSE;
Do_Graphics_Mode := ( VT100_G1_Set = '0' );
END
ELSE
BEGIN
IF ( Play_Music_On ) AND ( NOT Silent_Mode ) THEN
PibPlay( Escape_Str );
Escape_Mode := FALSE;
Escape_Str[0] := #0;
END;
SI: IF VT100_Allowed THEN
BEGIN
VT100_G0_State := TRUE;
Do_Graphics_Mode := ( VT100_G0_Set = '0' );
END
ELSE
BEGIN
Display_Character( Comm_Ch );
IF Do_Script_Tests THEN
Do_Script_Checks( Comm_Ch );
END;
(* CompuServe B protocol request *)
ENQ: IF CompuServe_B_On THEN
B := Do_CompuServe_B_Transfer
ELSE
IF VT100_Allowed THEN
Async_Send_String( VT100_Answerback_Message )
ELSE
BEGIN
Display_Character( Comm_Ch );
IF Do_Script_Tests THEN
Do_Script_Checks( Comm_Ch );
END;
(* Cancel escape sequence in progress *)
CAN,
ENQ: IF Escape_Mode THEN
BEGIN
Escape_Mode := FALSE
END
ELSE
BEGIN
Display_Character( Comm_Ch );
IF Do_Script_Tests THEN
Do_Script_Checks( Comm_Ch );
END;
ELSE
BEGIN
Display_Character( Comm_Ch );
IF Do_Script_Tests THEN
Do_Script_Checks( Comm_Ch );
END;
END (* CASE *);
Graphics_Mode := Do_Graphics_Mode;
END (* Handle_VT100_Special *);
(*----------------------------------------------------------------------*)
(* VT100_Process_Escape --- Process VT100 escape sequence *)
(*----------------------------------------------------------------------*)
PROCEDURE VT100_Process_Escape( Ch : CHAR;
VAR Done : BOOLEAN );
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: VT100_Process_Escape *)
(* *)
(* Purpose: Processes escape sequence for DEC VT100 emulation *)
(* *)
(* Calling Sequence: *)
(* *)
(* VT100_Process_Escape( Ch: CHAR; VAR Done: BOOLEAN ); *)
(* *)
(* Ch --- Next character in escape sequence *)
(* Done --- Set TRUE to exit ANSI/VT100 mode *)
(* *)
(* Called by: Emulate_Ansi *)
(* *)
(* Remarks: *)
(* *)
(* This version processes private DEC escape sequences. *)
(* *)
(*----------------------------------------------------------------------*)
VAR
Reg_Val : INTEGER;
Save_X : INTEGER;
Save_Y : INTEGER;
I : INTEGER;
J : INTEGER;
More_Escape : BOOLEAN;
S : AnyStr;
Regs : RegPack;
(* STRUCTURED *) CONST
VT100_Char_Sets : SET OF CHAR = ['A','B','0','1','2'];
BEGIN (* VT100_Process_Escape *)
More_Escape := FALSE;
(* Ignore blanks *)
IF ( Ch = ' ' ) THEN EXIT;
(* Process char depending upon current *)
(* escape type mode *)
CASE Escape_Type OF
' ': CASE Ch OF
'#',
'[',
'O',
'?': BEGIN
Escape_Type := Ch;
EXIT;
END;
'D': BEGIN
IF ( WhereY < Bottom_Scroll ) THEN
BEGIN
MoveToXY( WhereX , WhereY + 1 );
Last_Column_Hit := FALSE;
END
ELSE
BEGIN
Save_X := WhereX;
Save_Y := WhereY;
Scroll( Top_Scroll, Bottom_Scroll, 1,
Max_Screen_Col, 1, FG, BG );
MoveToXY( Save_X, Save_Y );
Ansi_Scroll_Attributes( 1 , Bottom_Scroll );
END;
END;
'E': BEGIN
IF ( WhereY < Bottom_Scroll ) THEN
BEGIN
MoveToXY( 1 , WhereY + 1 );
Last_Column_Hit := FALSE;
END
ELSE
BEGIN
Save_Y := WhereY;
Scroll( Top_Scroll, Bottom_Scroll, 1,
Max_Screen_Col, 1, FG, BG );
MoveToXY( 1 , Save_Y );
Ansi_Scroll_Attributes( 1 , Bottom_Scroll );
END;
END;
'M': BEGIN
{==
Window( 1, 1, Max_Screen_Col, Ansi_Last_Line );
==}
IF WhereY > Top_Scroll THEN
BEGIN
MoveToXY( WhereX , WhereY - 1 );
Last_Column_Hit := FALSE;
END
ELSE
BEGIN
Save_X := WhereX;
Save_Y := WhereY;
Save_FG := FG;
Save_BG := BG;
FG := Ansi_ForeGround_Color;
BG := Ansi_BackGround_Color;
Scroll( Top_Scroll, Bottom_Scroll, 1, Max_Screen_Col,
-1, FG, BG );
FG := Save_FG;
BG := Save_BG;
Ansi_Scroll_Attributes( -1, Bottom_Scroll - 1 );
MoveToXY( Save_X, Save_Y );
END;
{==
IF Origin_Mode THEN
Window( 1, Top_Scroll, Max_Screen_Col, Bottom_Scroll );
==}
END;
'7': BEGIN
Regs.Ah := 3;
Regs.Bh := 0;
INTR( $10 , Regs );
Save_Col_Position := Regs.Dl;
Save_Row_Position := Regs.Dh;
Save_FG_Color := FG;
Save_BG_Color := BG;
Save_Graphics_Mode := Graphics_Mode;
Save_Bolding := Bolding_On;
Save_Blinking := Blinking_On;
Save_Done := TRUE;
Save_Top_Scroll := Top_Scroll;
Save_Bottom_Scroll := Bottom_Scroll;
Save_Origin_Mode := Origin_Mode;
END;
'8': BEGIN
Regs.Ah := 2;
Regs.Bh := 0;
Regs.Dh := Save_Row_Position;
Regs.Dl := Save_Col_Position;
INTR( $10 , Regs );
FG := Save_FG_Color;
BG := Save_BG_Color;
Bolding_On := Save_Bolding;
Blinking_On := Save_Blinking;
Graphics_Mode := Save_Graphics_Mode;
{
Top_Scroll := Save_Top_Scroll;
Bottom_Scroll := Save_Bottom_Scroll;
Origin_Mode := Save_Origin_Mode;
}
IF Blinking_On THEN
TextColor( FG + Blink )
ELSE
TextColor( FG );
TextBackGround( BG );
Set_Global_Colors( FG , BG );
END;
'H': VT100_Set_Tab;
')': BEGIN
Escape_Type := ')';
Ch := Ansi_Next_Char;
IF ( Ch IN VT100_Char_Sets ) THEN
BEGIN
VT100_G1_Set := Ch;
IF ( NOT VT100_G0_State ) THEN
Graphics_Mode := ( VT100_G1_Set = '0' );
END;
END;
'(': BEGIN
Escape_Type := '(';
Ch := Ansi_Next_Char;
IF ( Ch IN VT100_Char_Sets ) THEN
BEGIN
VT100_G0_Set := Ch;
IF VT100_G0_State THEN
Graphics_Mode := ( VT100_G0_Set = '0' );
END;
END;
'<': BEGIN
Escape_Mode := FALSE;
EXIT;
END;
'r': BEGIN (* Terminal Reset *)
Top_Scroll := 1;
Bottom_Scroll := Ansi_Last_Line;
Clear_Window;
FillChar( Line_Attributes, Max_Screen_Line, 0 );
END;
'Z': Async_Send_String( CHR( 27 ) + '[?1;0c' );
'=': Alt_Keypad_Mode := ON;
'>': Alt_Keypad_Mode := OFF;
'c': Ansi_Reset_Terminal;
ELSE More_Escape := TRUE;
END (* CASE *);
'[': CASE Ch OF
'?': BEGIN
Escape_Type := Ch;
EXIT;
END;
'A': Ansi_Cursor_Up;
'B': Ansi_Cursor_Down;
'C': Ansi_Cursor_Right;
'D': Ansi_Cursor_Left;
'H': Ansi_Set_Cursor;
'J': Ansi_Clear_Screen;
'K': Ansi_Clear_Line;
'L': Ansi_Insert_Lines;
'f': Ansi_Set_Cursor;
'}',
'm': Ansi_Set_Graphics;
'r': Ansi_Set_Scrolling_Region;
'h': Ansi_Set_Mode(' ');
'i': Ansi_Printer_Control(' ');
'l': Ansi_Reset_Mode( ' ' , Done );
'g': VT100_Clear_Tabs;
'M': Ansi_Delete_Lines;
'c': Async_Send_String( CHR( 27 ) + '[?1;0c' );
'n': Ansi_Status_Report;
'P': Ansi_Delete_Chars;
'q': VT100_Set_LEDs;
's': (* Protected fields not implemented *);
'x': VT100_Send_Terminal_Parameters;
'y': ;
'@': Ansi_Insert_Chars;
ELSE More_Escape := TRUE;
END (* CASE *);
'?': CASE Ch OF
'h': Ansi_Set_Mode('?');
'i': Ansi_Printer_Control('?');
'l': Ansi_Reset_Mode( '?' , Done );
ELSE More_Escape := TRUE;
END (* CASE *);
'#': CASE Ch OF
'3',
'4',
'5',
'6': BEGIN
Reg_Val := ORD( Ch ) - ORD('0');
IF ( Reg_Val = 5 ) THEN
Reg_Val := 0;
Line_Attributes[ WhereY ] := Reg_Val;
Set_Cursor( WhereX , WhereY );
END;
'8': BEGIN
S := DUPL( 'E', Wrap_Screen_Col );
FOR I := 1 TO ( Max_Screen_Line - 1 ) DO
WriteSXY( S, 1, I,
( Global_BackGround_Color AND 7 ) SHL 4 +
Global_ForeGround_Color );
END;
ELSE More_Escape := TRUE;
END (* CASE *);
'O': CASE Ch OF
'A': Ansi_Cursor_Up;
'B': Ansi_Cursor_Down;
'C': Ansi_Cursor_Right;
'D': Ansi_Cursor_Left;
ELSE More_Escape := TRUE;
END (* CASE *);
ELSE More_Escape := TRUE;
END (* CASE Escape_Type *);
IF ( NOT More_Escape ) THEN
Escape_Mode := FALSE
ELSE
BEGIN
Ch := UpCase( Ch );
Escape_Str := Escape_Str + Ch;
IF Ch IN Lets THEN EXIT;
IF Ch IN Digits THEN
BEGIN
Escape_Register[Escape_Number] :=
( Escape_Register[Escape_Number] * 10 ) + ORD( Ch ) -
ORD( '0' );
EXIT;
END;
CASE Ch OF
';', ',' : BEGIN
Escape_Number := Escape_Number + 1;
Escape_Register[Escape_Number] := 0;
END;
'T', 'S', '#', '+', '-', '>', '<', '.','?','='
: ;
ELSE
Escape_Mode := FALSE;
Ansi_Write_Escape;
END (* Case *);
END (* NOT More_Escape *);
END (* VT100_Process_Escape *);
(*----------------------------------------------------------------------*)
(* Process_Printer_Escapes --- Process printer escape sequence *)
(*----------------------------------------------------------------------*)
PROCEDURE Process_Printer_Escapes( Ch : CHAR );
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Process_Printer_Escapes *)
(* *)
(* Purpose: Processes printer control escape sequences only *)
(* *)
(* Calling Sequence: *)
(* *)
(* Process_Printer_Escapes( Ch: CHAR ); *)
(* *)
(* Ch --- Next character in escape sequence *)
(* *)
(* Called by: Emulate_Ansi *)
(* *)
(*----------------------------------------------------------------------*)
VAR
More_Escape : BOOLEAN;
BEGIN (* Process_Printer_Escapes *)
More_Escape := TRUE;
(* Ignore blanks *)
IF ( Ch = ' ' ) THEN
BEGIN
Escape_Str := Escape_Str + Ch;
EXIT;
END;
(* Process char depending upon current *)
(* escape type mode *)
CASE Escape_Type OF
' ': CASE Ch OF
'#',
'[',
'O',
'?': BEGIN
Escape_Str := Escape_Str + Ch;
Escape_Type := Ch;
EXIT;
END;
ELSE;
END (* CASE *);
'[': IF ( Ch = 'i' ) THEN
BEGIN
Ansi_Printer_Control(' ');
More_Escape := FALSE;
END;
ELSE;
END (* CASE Escape_Type *);
IF ( NOT More_Escape ) THEN
Escape_Mode := FALSE
ELSE
BEGIN
Escape_Str := Escape_Str + Ch;
Ch := UpCase( Ch );
IF Ch IN Lets THEN EXIT;
IF Ch IN Digits THEN
BEGIN
Escape_Register[Escape_Number] :=
( Escape_Register[Escape_Number] * 10 ) + ORD( Ch ) -
ORD( '0' );
EXIT;
END;
CASE Ch OF
';', ',' : BEGIN
Escape_Number := Escape_Number + 1;
Escape_Register[Escape_Number] := 0;
END;
'T', 'S', '#', '+', '-', '>', '<', '.','?','='
: ;
ELSE
Escape_Mode := FALSE;
WRITE( Lst, Escape_Str );
END (* Case *);
END (* NOT More_Escape *);
END (* Process_Printer_Escapes *);
(*----------------------------------------------------------------------*)
BEGIN (* Emulate_ANSI *)
(* We don't go through DOS here *)
Save_Dos_Con := Use_Dos_Con_Output;
Use_Dos_Con_Output := FALSE;
(* Initialize text terminal mode *)
Init_Text_Terminal;
(* Background, foreground *)
Save_Global_FG := Global_ForeGround_Color;
Save_Global_BG := Global_BackGround_Color;
Save_FG := ForeGround_Color;
Save_BG := BackGround_Color;
Save_EG := Border_Color;
(* Set the terminal *)
Ansi_Reset_Terminal;
(* Loop over input until done *)
WHILE ( NOT Done ) DO
BEGIN
IF KeyPressed THEN
BEGIN (* KeyPressed *)
Save_Do_Status := Do_Status_Line;
Save_FG1 := FG;
Save_BG1 := BG;
Set_Global_Colors( Save_Global_FG , Save_Global_BG );
Handle_Keyboard_Input( Done , Reset_Requested , ClrScr_Request );
Set_Global_Colors( Save_FG1 , Save_BG1 );
IF Reset_Requested THEN
BEGIN
Clear_Window;
Ansi_Reset_Terminal;
END
ELSE IF ClrScr_Request THEN
Clear_Window
ELSE IF ( Save_Do_Status <> Do_Status_Line ) THEN
BEGIN
IF Do_Status_Line THEN
Ansi_Last_Line := Max_Screen_Line - 1
ELSE
Ansi_Last_Line := Max_Screen_Line;
Window( 1, 1, Max_Screen_Col, Ansi_Last_Line );
Set_Screen_Size( Ansi_Last_Line , Max_Screen_Col );
END;
END (* KeyPressed *);
(* Process a script command if any *)
IF ( Script_File_Mode AND ( NOT ( Done OR Really_Wait_String ) ) ) THEN
BEGIN
Get_Script_Command( PibTerm_Command );
Execute_Command ( PibTerm_Command , Done , TRUE );
END;
(* Hold everything while scroll lock on *)
IF Scroll_Lock_On THEN
Handle_Scroll_Lock;
(* Handle carrier drop *)
IF Carrier_Dropped THEN
Handle_Carrier_Drop;
(* Process char received from comm port *)
IF ( Async_Buffer_Head <> Async_Buffer_Tail ) THEN
BEGIN (* Comm_Ch found *)
(* Get the character *)
B := Async_Receive( Comm_Ch );
(* Strip high bit if requested *)
IF Auto_Strip_High_Bit THEN
Comm_Ch := CHR( ORD( Comm_Ch ) AND $7F );
(* Perform translation *)
Comm_Ch := TrTab[Comm_Ch];
(* Handle printer control mode *)
IF Printer_Ctrl_Mode THEN
BEGIN
IF Escape_Mode THEN
Process_Printer_Escapes( Comm_Ch )
ELSE IF ( Comm_Ch = CHR( ESC ) ) THEN
BEGIN
IF Escape_Mode THEN
WRITE( LST , Escape_Str );
Escape_Str := Comm_Ch;
Escape_Number := 1;
Escape_Register[1] := 0;
Escape_Mode := TRUE;
Escape_Type := ' ';
Getting_Music := FALSE;
END
ELSE
WRITE( LST, Comm_Ch );
END
(* Check for special control character *)
ELSE IF Special_Comm[ ORD( Comm_Ch ) ] THEN
Handle_VT100_Special( Comm_Ch )
(* Check for escape sequence to process *)
ELSE IF Escape_Mode THEN
CASE VT100_Allowed OF
TRUE: VT100_Process_Escape( Comm_Ch , Done );
FALSE: Ansi_Process_Escape( Comm_Ch );
END (* CASE *)
ELSE
BEGIN (* Ordinary character *)
Double_Ch := ' ';
IF Graphics_Mode THEN
BEGIN (* Graphics Mode *)
IF ORD( Comm_Ch ) IN [ 95 .. 126 ] THEN
BEGIN
Graph_Ch := VT100_Graphics_Chars[ ORD( Comm_Ch ) ];
Comm_Ch := CHR( Graph_Ch );
END;
IF Double_Width_Mode THEN
IF ( Comm_Ch = CHR(196) ) OR
( Comm_Ch = CHR(192) ) OR
( Comm_Ch = CHR(218) ) THEN
Double_Ch := CHR( 196 );
END (* Graphics Mode *);
Display_Character( Comm_Ch );
IF Double_Width_Mode THEN
Display_Character( Double_Ch );
IF Do_Script_Tests THEN
Do_Script_Checks( Comm_Ch );
END (* Ordinary character *);
END (* Comm_Ch found *)
(* Check if waitstring time exhausted *)
ELSE
BEGIN
Async_Line_Status := Async_Line_Status AND $FD;
IF Really_Wait_String THEN
Check_Wait_String_Time;
IF ( ( NOT KeyPressed ) AND ( NOT Script_File_Mode ) ) THEN
IF ( Async_Buffer_Head = Async_Buffer_Tail ) THEN
GiveAwayTime( 1 );
END;
END (* NOT Done *);
(* Reset whole screen as window *)
Window( 1, 1, Max_Screen_Col, Max_Screen_Line );
(* Restore colors *)
Reset_Attr := ( ForeGround_Color <> Save_FG ) OR
( BackGround_Color <> Save_BG );
ForeGround_Color := Save_FG;
BackGround_Color := Save_BG;
Border_Color := Save_EG;
Set_Global_Colors( ForeGround_Color , BackGround_Color );
Set_Border_Color ( Border_Color );
IF Reset_Attr THEN
Set_Text_Attributes( 1, 1, Max_Screen_Col, Max_Screen_Line,
ForeGround_Color, BackGround_Color );
Use_Dos_Con_Output := Save_Dos_Con;
END (* Emulate_ANSI *);